home *** CD-ROM | disk | FTP | other *** search
/ Language/OS - Multiplatform Resource Library / LANGUAGE OS.iso / pcr / pcr4_4.lha / DIST / interp / Interp.c next >
C/C++ Source or Header  |  1991-07-25  |  44KB  |  1,767 lines
  1. /* begincopyright
  2.   Copyright (c) 1988 Xerox Corporation. All rights reserved.
  3.   Use and copying of this software and preparation of derivative works based
  4.   upon this software are permitted. Any distribution of this software or
  5.   derivative works must comply with all applicable United States export
  6.   control laws. This software is made available AS IS, and Xerox Corporation
  7.   makes no warranty about the software, its performance or its conformity to
  8.   any specification. Any person obtaining a copy of this software is requested
  9.   to send their name and post office or electronic mail address to:
  10.     PCR Coordinator
  11.     Xerox PARC
  12.     3333 Coyote Hill Rd.
  13.     Palo Alto, CA 94304
  14.   endcopyright */
  15.  
  16. /*
  17.  * Interp.c
  18.  *
  19.  * Interim (!) interpreter tool for PCR.
  20.  *
  21.  * Demers, October 3, 1990 2:17:08 pm PDT
  22.  *
  23.  */
  24.  
  25. /*
  26.  
  27. This is a simple interpreter to be run in PCR.  Run it by:
  28.  
  29.     pcr: unixload /the/pathname/of/Interp.o
  30.  
  31. This registers a single comand,
  32.  
  33.     pcr: eval <expression>
  34.  
  35. where the <expression> is a prefix expression with syntax described below.
  36. The effect is to evaluate the expression an store its value in an interpreter
  37. variable, which can later be examined and used as a subexpression in another
  38. interpreter call.  Syntax:
  39.  
  40. <expression> ::= <number>
  41.  
  42.     Evaluates the number.
  43.     Legal numeric constants include 17, 010, 0x5c, but NOT -3
  44.  
  45. <expression> ::= <string>
  46.  
  47.     Evaluates the string.
  48.     Legal string constants include "foo", "bar", but NOT "hello\n".
  49.  
  50. <expression> ::= <char>
  51.  
  52.     Evaluates the character.
  53.     Legal char constants include 'x', '0', but NOT `\n`.
  54.  
  55. <expression> ::= @ <expression1> <expression2>
  56.  
  57.     Evaluates the expressions, prints the value of <expression2> according
  58.     to the type of <expression1>.
  59.     Example: eval @ "" 0x126a4c might be used to pring a string.
  60.  
  61. <expression> ::= <binop> <expression1> <expression2>
  62.  
  63.     Evaluates the <expression>s, combines them according to <op>.
  64.     Recognized <op>s are +, -, *, /.
  65.  
  66. <expression> ::= ^ <expression>
  67.  
  68.     Evaluates the <expression>, interprets it as an address and returns
  69.     the word value stored there.
  70.  
  71. <expression> ::=  <  <variable> <expression>
  72.  
  73.     Assign the value of <expression> to the specified interpreter <variable>
  74.  
  75. <expression> ::=  [ <expression0> <expression1> ... <expressionk> ]
  76.  
  77.     Function call: <expression0> should evaluate to the address of a function;
  78.     that function is called in a separate thread with the values of
  79.     <expression1> ... <expressionk> as arguments.  The call times out after
  80.     awhile; the timeout interval (in msec) is controlled by the global variable
  81.     interpCallTimeout, which can be changed using the interpreter ...
  82.  
  83. <expression> ::=  [! <expression0> <expression1> ... <expressionk> ]
  84.  
  85.     [! is just like [ except the call is done in the interpreter's thread,
  86.     and can never time out.
  87.  
  88. <expression> ::=  <variable>
  89.  
  90.     An interpreter variable, which may be assigned to or evaluated.
  91.     Undefined variables are initially 0.
  92.  
  93. <expression> :=  <symbol>
  94.  
  95.     The value of an external symbol in the loadstate.  Numerous grotty
  96.     heuristics are applied during symbol lookup, such as appending a leading
  97.     underscore for C externals.  For example,
  98.     
  99.         pcr: eval XR_Msg
  100.         &11: 0x1a4f0 ...
  101.  
  102.     The loadstate keeps internal text symbols, but not internal data or bss
  103.     symbols.
  104.  
  105. <expression> ::=  <symbol>.<symbol>
  106.  
  107.     The first symbol is expected to be a file or module name, the second
  108.     to be a text in that module.  As above, heuristics are applied to
  109.     the file/module name (appending ".o") and the text symbol (prepending
  110.     an underscore, and some really arcane transformations related to the
  111.     procedure names generated by our Cedar/Mesa to C compiler).  Example:
  112.  
  113.         pcr: eval Interp.XR_GetSaveForInterp
  114.         &12: 0x60bf08 ...
  115.  
  116.     An expression like this usually appears in the function position of a
  117.     call.
  118.  
  119. <variable> ::=  &<number>
  120.  
  121.     The result of each eval call is stored in a numbered variable, which
  122.     is accessible in later calls.
  123.  
  124. <variable> ::=  &<symbol>
  125.  
  126.     Variables can be named as well as numbered.  Example:
  127.  
  128.         eval + < &foo 17 &foo
  129.         &13: 34 ...
  130.  
  131.     Note that foo is assigned to before it's evaluated ...
  132.  
  133. <variable> ::=  &
  134.  
  135.     & is the name of the most-recently-created numeric interpreter variable.
  136.  
  137.  
  138. There is also a simple programmer's interface to this, through which you
  139. can save values in interpreter variables and print messages on the interpreter's
  140. output stream.  These procedures appear at the end of the file.
  141.  
  142. Hint: if you don't know what a "Rope" is, avoid the procedures that deal with
  143. them!
  144.  
  145. */
  146.  
  147. #include "xr/BasicTypes.h"
  148. #include "xr/Threads.h"
  149. #include "xr/ThreadsBackdoor.h"
  150. #include "xr/ThreadsMsgPrivate.h"
  151. #include "xr/CommandLine.h"
  152. #include "xr/CommandLoop.h"
  153. #include "xr/UIO.h"
  154. #include "xr/Errno.h"
  155. #include "xr/IncrementalLoad.h"
  156.  
  157. extern char *( strchr(/* char *str, char c */) );
  158. extern char *( strrchr(/* char *str, char c */) );
  159.  
  160. /* poor replacement for strtol library routine ... */
  161.  
  162. static int
  163. DigitVal(c)
  164.     char c;
  165. {
  166.     if( (c >= '0') && (c <= '9') ) return (c - '0');
  167.     if( (c >= 'a') && (c <= 'f') ) return (c - 'a' + 10);
  168.     if( (c >= 'A') && (c <= 'F') ) return (c - 'A' + 10);
  169.     return 999999;
  170. }
  171.  
  172. int strtol(s, ptr, base)
  173.     char *s;
  174.     char **ptr;
  175.     int base;
  176. {
  177.     int ans = 0;
  178.     char c, cLimit;
  179.     int sign = 1;
  180.     int digitVal;
  181.  
  182.     if( s[0] == '+' ) s++;
  183.     if( s[0] == '-' ) { sign = -1; s++; }
  184.     if( base == 0 ) {
  185.         base = 10;
  186.         if( s[0] == '0' ) {
  187.             base = 8; s++;
  188.             if( s[0] == 'x' ) {
  189.                 base = 16; s++;
  190.             }
  191.         }
  192.     }
  193.     for(;;) {
  194.         digitVal = DigitVal(*s);
  195.         if( digitVal >= base ) break;
  196.         ans = (ans * base) + digitVal;
  197.         s++;
  198.     }
  199.     if( ptr != NIL )
  200.         *ptr = s;
  201.     return ans * sign;
  202. }
  203.  
  204.  
  205. /*
  206.  * safe memory access ...
  207.  */
  208.  
  209. static bool
  210. ValidAddress(addr, eltCnt, eltBytes)
  211.     XR_Pointer addr;
  212.     unsigned eltCnt;
  213.     unsigned eltBytes;
  214. {
  215.     XR_Pointer limit, stackLimit;
  216.  
  217.     if( (addr & (eltBytes-1)) != 0 ) return FALSE;
  218.  
  219.     if( addr < XR_GetPageSize() ) return FALSE;
  220.  
  221.     limit = XR_ComputeAddress(
  222.             addr,
  223.             eltCnt*eltBytes,
  224.             XR_DONT_ROUND );
  225.     stackLimit =
  226.         XR_sysArea->sa_threadPool[XR_maxThreads-1].t_stack.stack_physLimit;
  227.     if( limit > stackLimit ) return FALSE;
  228.  
  229.     return TRUE;
  230. }
  231.  
  232.  
  233.  
  234.  
  235. /*
  236.  * The Interpreter
  237.  */
  238.  
  239.  
  240. #define MAX_TOKENS        50
  241. #define MAX_CALLARGS        20
  242. #define MSG_BUFSIZE        512
  243.  
  244. unsigned defaultCallTimeoutMsec = 20000;
  245.  
  246. #define TYPE_ERR        0
  247.  
  248. #define TYPE_NONE        1
  249. #define TYPE_CHAR        2
  250. #define TYPE_STRING        3
  251. #define TYPE_WORD32        4
  252. #define TYPE_ADDRESS        5
  253. #define TYPE_UNDEFSYM        6
  254.  
  255. #define TOK_ERR            0
  256. #define TOK_EOF            1
  257. #define TOK_ASSIGN        2
  258. #define TOK_LBRACKET        3
  259. #define TOK_LBRACKET2        4
  260. #define TOK_RBRACKET        5
  261. #define TOK_CAST        6
  262. #define TOK_ADD            7
  263. #define TOK_SUB            8
  264. #define TOK_MUL            9
  265. #define TOK_DIV            10
  266. #define TOK_DEREF        11
  267. #define TOK_SEPARATOR        12
  268. #define TOK_VAR            13
  269. #define TOK_CONST        14
  270.  
  271.  
  272. typedef struct ReservedWordRep {
  273.     char *rw_string;
  274.     int rw_kind;
  275. } * ReservedWord;
  276.  
  277.  
  278. static struct ReservedWordRep reservedWords[] = {
  279.     { "<", TOK_ASSIGN },
  280.     { "[", TOK_LBRACKET },
  281.     { "[!", TOK_LBRACKET2 },
  282.     { "]", TOK_RBRACKET },
  283.     { "@", TOK_CAST },
  284.     { "+", TOK_ADD  },
  285.     { "-", TOK_SUB  },
  286.     { "*", TOK_MUL  },
  287.     { "/", TOK_DIV  },
  288.     { "^", TOK_DEREF },
  289.     { ",", TOK_SEPARATOR },
  290.     { ";", TOK_SEPARATOR }
  291. };
  292.  
  293.  
  294. typedef struct ExpRep {
  295.     struct ExpRep *exp_next;
  296.     char *exp_name;
  297.     int exp_type;
  298.     unsigned exp_value;
  299. } * Exp;
  300.  
  301.  
  302.  
  303.  
  304. typedef struct TokRep {
  305.     int tok_kind;
  306.     Exp tok_exp;
  307. } * Tok;
  308.  
  309.  
  310. typedef unsigned (*CProc)();
  311.  
  312. typedef struct CallRecordRep {
  313.     struct CallRecordRep *cr_next;
  314.     struct XR_MLRep cr_ml;
  315.     struct InterpDataRep *cr_idata;
  316.     CProc cr_calleeCProc;
  317.     struct XR_MesaProcRep cr_calleeMProc;
  318.     struct XR_CTRep cr_calleeThread;
  319.     struct XR_CVRep cr_cvDone;
  320.     Exp cr_result;
  321.     int cr_nArgs;
  322.     unsigned cr_args[MAX_CALLARGS];
  323. } * CallRecord;
  324.  
  325.  
  326. CallRecord callRecords = NIL;
  327. static struct XR_MLRep callRecordsLock;
  328.  
  329.  
  330. typedef struct InterpDataRep {
  331.     struct XR_MLRep idata_ml;
  332.     int idata_errPos;
  333.     char *idata_errMsg;
  334.     int idata_varIndex;
  335.     Exp idata_vars;
  336.     CProc idata_putProc /*(char *s, XR_Pointer clientData)*/;
  337.     XR_Pointer idata_putClientData;
  338.     unsigned idata_callTimeoutMsec;
  339.     struct TokRep idata_tokens[MAX_TOKENS];
  340.     char idata_msgBuf[MSG_BUFSIZE];
  341. } * InterpData;
  342.  
  343. InterpData interpData = NIL;            /* default interp handle */
  344. InterpData interpDataForConstEval = NIL;    /* for const evaluation */
  345.  
  346. /*
  347.  * message printing
  348.  */
  349.  
  350. static void
  351. Put4(idata, fmt, x1, x2, x3, x4)
  352.     InterpData idata;
  353.     char *fmt;
  354.     unsigned x1, x2, x3, x4;
  355. /*
  356.     Assumes idata->idata_ml is held or idata is NIL.
  357. */
  358. {
  359.     if( idata == NIL ) {
  360. XR_ConsoleMsg(fmt, x1, x2, x3, x4); /* ??? */
  361.         return;
  362.     }
  363.     XR_SPrintF( idata->idata_msgBuf, fmt, x1, x2, x3, x4 );
  364.     (void)( (*(idata->idata_putProc))(
  365.             idata->idata_msgBuf, idata->idata_putClientData ));
  366. }
  367.  
  368. #define PUT(idata) (void)( (*((idata)->idata_putProc))( \
  369.         (idata)->idata_msgBuf, (idata)->idata_putClientData ))
  370.  
  371. #define MSG0(idata,fmt) \
  372.     { Put4((idata), (fmt), 0, 0, 0, 0); }
  373.  
  374. #define MSG1(idata,fmt,x1) \
  375.     { Put4((idata), (fmt), (x1), 0, 0, 0); }
  376.  
  377. #define MSG2(idata,fmt,x1,x2) \
  378.     { Put4((idata), (fmt), (x1), (x2), 0, 0); }
  379.  
  380. #define MSG3(idata,fmt,x1,x2,x3) \
  381.     { Put4((idata), (fmt), (x1), (x2), (x3), 0); }
  382.  
  383. #define MSG4(idata,fmt,x1,x2,x3,x4) \
  384.     { Put4((idata), (fmt), (x1), (x2), (x3), (x4)); }
  385.  
  386. /*
  387.  * error reporting
  388.  */
  389.  
  390. static void
  391. SetInterpErr(idata, pos, msg)
  392.     InterpData idata;
  393.     int pos;
  394.     char *msg;
  395. {
  396.     if( (msg == NIL) || (idata->idata_errMsg == NIL) ) {
  397.         idata->idata_errMsg = msg;
  398.         idata->idata_errPos = pos;
  399.     }
  400. }
  401.  
  402.  
  403. #define INTERP_ERR(idata, pos, msg) { \
  404.         SetInterpErr((idata), (pos), (msg)); \
  405.         return (-1); \
  406.     }
  407.  
  408. #define CLEAR_INTERP_ERR(idata) \
  409.         SetInterpErr((idata), 0, NIL)
  410.  
  411.  
  412.  
  413. static int
  414. ReservedWordKind(w)
  415.     char *w;
  416. {
  417.     int i;
  418.     int ans;
  419.  
  420.     for(
  421.         i = 0
  422.         ; i < ((sizeof reservedWords)/(sizeof(struct ReservedWordRep)))
  423.         ; i++
  424.     ) {
  425.         if( strcmp(reservedWords[i].rw_string, w) == 0 )
  426.             return(reservedWords[i].rw_kind);
  427.     }
  428.     return 0;
  429. }
  430.  
  431.  
  432.  
  433. static Exp
  434. NewExp(idata, t, v)
  435.     InterpData idata;
  436.     int t;
  437.     unsigned v;
  438. {
  439.     Exp e = (Exp)XR_calloc( sizeof(struct ExpRep), 1 );
  440.     e->exp_type = t;
  441.     e->exp_value = v;
  442.     return e;
  443. }
  444.  
  445.  
  446. static Exp
  447. NewVar(idata, name)
  448.     InterpData idata;
  449.     char *name;
  450. {
  451.     Exp e = (Exp)XR_calloc( sizeof(struct ExpRep), 1 );
  452.     e->exp_type = TYPE_NONE;
  453.     e->exp_value = 0;
  454.     if( name != NIL ) {
  455.         e->exp_name = (char *)XR_malloc( 1 + strlen(name) );
  456.         strcpy( e->exp_name, name );
  457.     }
  458.     return e;
  459. }
  460.  
  461.  
  462. static Exp
  463. ScanVar(idata, name)
  464.     InterpData idata;
  465.     char *name;
  466. {
  467.     Exp p, prev;
  468.     char tempNameBuf[20];
  469.  
  470.     if( strcmp("&", name) == 0 ) {
  471.         XR_SPrintF(tempNameBuf, "&%d", idata->idata_varIndex );
  472.         name = tempNameBuf;
  473.     }
  474.     prev = NIL;
  475.     p = idata->idata_vars;
  476.     for(;;) {
  477.         if( p == NIL ) break;
  478.         if( strcmp(p->exp_name, name) == 0 ) break;
  479.         prev = p;
  480.         p = p->exp_next;
  481.     }
  482.     if( p != NIL ) {
  483.         if( prev == NIL ) {
  484.             idata->idata_vars = p->exp_next;
  485.         } else {
  486.             prev->exp_next = p->exp_next;
  487.         }
  488.     } else {
  489.         p = NewVar(idata, name);
  490.     }
  491.     p->exp_next = idata->idata_vars;
  492.     idata->idata_vars = p;
  493.     return p;
  494. }
  495.  
  496.  
  497.  
  498. #define XXX 1
  499. #undef XXX
  500.  
  501. int
  502. InterpNameLookupC(name, valp)
  503.     char *name;
  504.     unsigned *valp;
  505. {
  506.     XR_ILSymEntry ilse;
  507.     char *altText;
  508.  
  509.     ilse = XR_ILGetMatchingSymEntryByName(
  510.             NIL, name, TRUE, WANT_ALL_TYPES, IGNORE_INTERNAL, 0 );
  511.     if( ilse == NIL ) {
  512.         ilse = XR_ILGetMatchingSymEntryByName(
  513.                 NIL, name, TRUE, WANT_ALL_TYPES, IGNORE_NONE, 0 );
  514.     }
  515.     if( (ilse == NIL) && (name[0] != '_') ) {
  516.         altText = (char *)XR_malloc(2+strlen(name));
  517.         altText[0] = '_'; (void)strcpy(&(altText[1]), name);
  518.         ilse = XR_ILGetMatchingSymEntryByName(
  519.                 NIL, altText, TRUE, WANT_ALL_TYPES, IGNORE_INTERNAL, 0 );
  520.         if( ilse == NIL ) {
  521.             ilse = XR_ILGetMatchingSymEntryByName(
  522.                 NIL, altText, TRUE, WANT_ALL_TYPES, IGNORE_NONE, 0 );
  523.         }
  524.     }
  525.     if( ilse == NIL ) {
  526.         return (-1);
  527.     }
  528.     *valp = ((unsigned)(ilse->ilse_value));
  529.     return 0;
  530. }
  531.  
  532.  
  533. int
  534. InterpNameLookupCedar(name, valp)
  535.     char *name;
  536.     unsigned *valp;
  537. {
  538.     static unsigned *((*procFromNamedInterface)()) = NIL;
  539.     int ans;
  540.     char *tailP, *dotP;
  541.     char *interfaceName;
  542.     char *procName;
  543.     unsigned *cedarProcValue;
  544.  
  545.     if( procFromNamedInterface == NIL ) {
  546.         ans = InterpNameLookupC( "_XR_ProcFromNamedInterface",
  547.                 &procFromNamedInterface );
  548.         if( ans < 0 ) return ans;
  549.     }
  550.     if( (dotP = strchr(name, '.')) == NIL ) {
  551.         return(-1);
  552.     }
  553.     if( (tailP =  strrchr(name, '.')) != dotP ) {
  554.         return(-1);
  555.     }
  556.     interfaceName = (char *)XR_malloc(dotP-name+1);
  557.     procName = (char *)XR_malloc(name+strlen(name)+1-tailP);
  558.     bcopy(name, interfaceName, dotP-name);
  559.     interfaceName[dotP-name] = 0;
  560.     strcpy(procName, tailP+1);
  561.     cedarProcValue = (*procFromNamedInterface)(interfaceName, procName, NIL, 0);
  562.     if( cedarProcValue == NIL ) {
  563.         return(-1);
  564.     }
  565.     (*valp) = (*cedarProcValue);
  566.     return 0;
  567. }
  568.  
  569.  
  570. static bool
  571. MimosaFileNameMatch(specified, found, caseSensitive)
  572.     char *specified;
  573.     char *found;
  574.     bool caseSensitive;
  575. {
  576.     char c;
  577.     char *p;
  578.     int specifiedLen;
  579.     int (*cmpFunc)();
  580.     extern int strncmp();
  581.     extern int strncasecmp();
  582.  
  583.     specifiedLen = strlen(specified);
  584.     cmpFunc = ( caseSensitive ? strncmp : strncasecmp );
  585.     if( (*cmpFunc)(specified, found, specifiedLen) != 0 ) return FALSE;
  586.     p = found+specifiedLen;
  587.     if( (*cmpFunc)(p, ".c2c.o", 6) == 0 ) {
  588.         p += 6;
  589.     } else if( (*cmpFunc)(p, ".o", 2) == 0 ) {
  590.         p += 2;
  591.     }
  592.     if( *p == 0 ) return TRUE;
  593.     if( *p++ != '.' ) return FALSE;
  594.     if( *p++ != '~' ) return FALSE;
  595.     for(;;) {
  596.         c = *p++;
  597.         if( c == '~' ) break;
  598.         if( (c < '0') || (c > '9') ) return FALSE;
  599.     }
  600.     return TRUE;    
  601. }
  602.  
  603.  
  604. static bool
  605. MimosaSymMatch(sym, msym)
  606.     char *sym;    /* symbol, pre-Mimosa/c2c */
  607.     char *msym;    /* symbol, possibly transformed by Mimosa/c2c */
  608. {
  609.     char c;
  610.  
  611.     if( (*msym == '_') && (*sym != '_') ) msym++;
  612.  
  613.     while( *sym ) {
  614.         if( *sym++ != *msym++ ) return FALSE;
  615.     }
  616.     if( *msym == 0 ) return TRUE;
  617.     if( *msym != '_' ) return FALSE;
  618.     msym++;
  619.     if( (*msym < 'A') || (*msym > 'Z') ) return FALSE;
  620.     msym++;
  621.     while(*msym) {
  622.         if( (*msym < '0') || (*msym > '9') ) return FALSE;
  623.         msym++;
  624.     }
  625.     return TRUE;
  626. }
  627.  
  628.  
  629. int
  630. InterpNameLookupFileC(name, valp)
  631.     char *name;
  632.     unsigned *valp;
  633. {
  634.     int ans;
  635.     char *tailP, *dotP;
  636.     char *fileName;
  637.     char *filePat;
  638.     char *procName;
  639.     int len;
  640.     XR_Pointer moduleStart, moduleLim;
  641.     XR_ILSymEntry ilse;
  642.     int i, caseSensitive;
  643.  
  644.     /* break out file name, file pattern, proc name */
  645.     if( (dotP = strchr(name, '.')) == NIL ) {
  646.         return(-1);
  647.     }
  648.     tailP = strrchr(name, '.');
  649.     len = strlen(name);
  650.     fileName = (char *)XR_malloc(len+1);
  651.     bcopy( name, fileName, (tailP-name) );
  652.     fileName[tailP-name] = 0;
  653.     filePat = (char *)XR_malloc(len+3); /* 3 = 1+strlen(".*") */
  654.     bcopy( name, filePat, (dotP-name) );
  655.     strcpy( filePat+(dotP-name), ".*" );
  656.     procName = (char *)XR_malloc(name+len+1-tailP);
  657.     strcpy( procName, tailP+1 );
  658.  
  659.     /* find module matching file name */
  660.     for( i = 0; i <= 1; i++ ) {
  661.         caseSensitive = (i == 0);
  662.         ilse = XR_ILGetMatchingSymEntryByName(
  663.             NIL, filePat, caseSensitive, WANT_ALL_TYPES, IGNORE_NONE, 0 );
  664.         for(;;) {
  665.             if( ilse == NIL )
  666.                 break;
  667.             if( ((ilse->ilse_type & ILSE_TYPE) == ILSE_MODULE)
  668.                     && MimosaFileNameMatch(fileName, ilse->ilse_name,
  669.                     caseSensitive) )
  670.                 break;
  671.             ilse = XR_ILGetMatchingSymEntryByName(
  672.                     ilse, filePat, caseSensitive,
  673.                     WANT_ALL_TYPES, IGNORE_NONE, 1 );
  674.         }
  675.         if( ilse != NIL ) break;
  676.     }
  677.     if( ilse != NIL ) {
  678.         moduleStart = (XR_Pointer)(ilse->ilse_value);
  679. #ifdef XXX
  680. XR_ConsoleMsg("Module %s at 0x%x\n ...", fileName, moduleStart);
  681. #endif
  682.         /* get most recently defined sym with given value */
  683.             ilse = XR_ILGetMatchingSymEntryByValue(
  684.                     NIL, moduleStart, WANT_ALL_TYPES, IGNORE_NONE, 0 );
  685.         /* search backward for symbol with length */
  686.             for(;;) {
  687.                 if( ilse == NIL ) break;
  688. #ifdef XXX
  689. XR_ConsoleMsg("  module sym %s type %d val 0x%x len 0x%x...\n", ilse->ilse_name, ilse->ilse_type, ilse->ilse_value, ilse->ilse_size);
  690. #endif
  691.                 if( ilse->ilse_value != moduleStart ) { ilse = NIL; break; }
  692.                 if( (ilse->ilse_size > 0)
  693.                         && ((ilse->ilse_type & ILSE_TYPE) == ILSE_MODULE) )
  694.                     break;
  695.                 ilse = XR_ILGetMatchingSymEntryByValue(
  696.                         ilse, 0, WANT_ALL_TYPES, IGNORE_NONE, (-1) );
  697.             }
  698.         /* (ilse != NIL) => <ilse_value, ilse_size> define module */
  699.     }
  700.  
  701.     /* find the named symbol */
  702.     if( ilse != NIL ) {
  703.         moduleStart = (XR_Pointer)(ilse->ilse_value);
  704.         moduleLim = XR_ComputeAddress(
  705.                 moduleStart, ilse->ilse_size, XR_DONT_ROUND );
  706. #ifdef XXX
  707. XR_ConsoleMsg("Module %s start 0x%x lim 0x%x...\n",
  708. ilse->ilse_name, moduleStart, moduleLim);
  709. #endif
  710.         for(;;) {
  711.             ilse = XR_ILGetMatchingSymEntryByValue(
  712.                     ilse, 0, WANT_ALL_TYPES, IGNORE_NONE, 1 );
  713.             if( ilse == NIL )
  714.                 { break; }
  715. #ifdef XXX
  716. XR_ConsoleMsg("  examining sym %s val 0x%x...\n",
  717. ilse->ilse_name, ilse->ilse_value);
  718. #endif
  719.             if( (((XR_Pointer)(ilse->ilse_value)) < moduleStart) )
  720.                 { /* cant happen */ continue; }
  721.             if( (((XR_Pointer)(ilse->ilse_value)) >= moduleLim) )
  722.                 { ilse = NIL; break; }
  723.             if( MimosaSymMatch(procName, ilse->ilse_name) )
  724.                 { break; }
  725.         }
  726.     } else {
  727.         ilse = NIL;
  728.     }
  729.     
  730.     if( ilse == NIL ) {
  731.         return(-1);
  732.     }
  733.     (*valp) = ilse->ilse_value;
  734.     return 0;
  735. }
  736.  
  737.  
  738. int
  739. InterpNameLookup(name, valp, how)
  740.     char *name;
  741.     unsigned *valp;
  742.     char *how;
  743. {
  744.     int ans;
  745.     unsigned val;
  746.  
  747.     if( name == NIL ) return (-1);
  748.     if( valp == NIL ) valp = &val;
  749.     if( (how != NIL) && (how[0] == 0) ) how = NIL;
  750.     if( (how == NIL) || (strcasecmp(how, "C") == 0) ) {
  751.         ans = InterpNameLookupC(name, valp);
  752.         if( ans >= 0 ) return ans;
  753.     }
  754.     if( (how == NIL) || (strcasecmp(how, "Cedar") == 0) ) {
  755.         ans = InterpNameLookupCedar(name, valp);
  756.         if( ans >= 0 ) return ans;
  757.     }
  758.     if( (how == NIL) || (strcasecmp(how, "CFile") == 0) ) {
  759.         ans = InterpNameLookupFileC(name, valp);
  760.         if( ans >= 0 ) return ans;
  761.     }
  762.     return (-1);
  763. }
  764.  
  765.  
  766. static void
  767. ScanSymbolConst(idata, text, e)
  768.     InterpData idata;
  769.     char *text;
  770.     Exp e;
  771. {
  772.     int ans;
  773.     unsigned v;
  774.  
  775.     ans = InterpNameLookup(text, &v, NIL);
  776.     if( ans >= 0 ) {
  777.         e->exp_type = TYPE_ADDRESS;
  778.         e->exp_value = v;
  779.     }
  780. }
  781.  
  782.  
  783.  
  784. static Exp
  785. ScanConst(idata, text)
  786.     InterpData idata;
  787.     char *text;
  788. {
  789.     Exp e;
  790.     char c;
  791.     char *b;
  792.     int n, len;
  793.  
  794.     e = NewExp(idata, TYPE_ERR, 0);
  795.     c = text[0];
  796.     if( ((c >= '0') && (c <= '9')) || (c == '-') || (c == '+') ) /* number */ {
  797.         n = strtol(text, &b, 0);
  798.         if( *b == 0 ) {
  799.             e->exp_type = TYPE_WORD32;
  800.             e->exp_value = (unsigned)n;
  801.         }
  802.     } else if( c == '"' ) {
  803.         text += 1;
  804.         len = strlen(text);
  805.         b = (char *)XR_malloc(1+len);
  806.         strcpy(b, text);
  807.         if( (len > 0) && (b[len-1] == '"') ) b[len-1] = 0;
  808.         e->exp_type = TYPE_STRING;
  809.         e->exp_value = (unsigned)b;
  810.         return e;
  811.     } else if( c == '\'' ) {
  812.         e->exp_type = TYPE_CHAR;
  813.         e->exp_value = (unsigned)(text[1]);
  814.     } else {
  815.         ScanSymbolConst(idata, text, e);
  816.     }
  817.     return e;
  818. }
  819.  
  820. static int
  821. ScanArgs(idata, theArgs)
  822.     InterpData idata;
  823.     char *theArgs;
  824. {
  825.     char *p;
  826.     char *thisArg;
  827.     char delim;
  828.     int k;
  829.     Exp e;
  830.     int ntoks;
  831.     char argbuf[1024];
  832.     
  833.  
  834.     strcpy(&(argbuf[0]), theArgs);
  835.     for( ntoks = 0; ntoks < MAX_TOKENS; ntoks++ ) {
  836.         idata->idata_tokens[ntoks].tok_kind = TOK_EOF;
  837.         idata->idata_tokens[ntoks].tok_exp = NIL;
  838.     }
  839.     CLEAR_INTERP_ERR(idata);
  840.     ntoks = 0;
  841.  
  842.     p = &(argbuf[0]);
  843.     for(;;) {
  844.         for(;;) {
  845.             if( *p == 0 ) goto Out;
  846.             if( (*p != ' ') && (*p != '\n') ) break;
  847.             p += 1;
  848.         }
  849.         thisArg = p;
  850.         switch( *p ) {
  851.             case '"':
  852.             case '\'':
  853.                 delim = *p;
  854.                 break;
  855.             default:
  856.                 delim = ' ';
  857.                 break;
  858.         }
  859.         p += 1;
  860.         for(;;) {
  861.             if( *p == 0 ) break;
  862.             if( (*p == delim) || (*p == '\n') ) { *p++ = 0; break; }
  863.             p += 1;
  864.         }
  865.         if( (k = ReservedWordKind(thisArg)) != 0 ) {
  866.             e = NIL;
  867.         } else if( thisArg[0] == '&' ) {
  868.             k = TOK_VAR;
  869.             e = ScanVar(idata, thisArg);
  870.             if( e->exp_type == TYPE_ERR )
  871.                 INTERP_ERR(idata, ntoks, "syntax error in variable");
  872.         } else {
  873.             k = TOK_CONST;
  874.             e = ScanConst(idata, thisArg);
  875.             if( e->exp_type == TYPE_ERR )
  876.                 INTERP_ERR(idata, ntoks, "syntax error in constant");
  877.             if( e->exp_type == TYPE_UNDEFSYM )
  878.                 INTERP_ERR(idata, ntoks, "undefined symbol");
  879.         }
  880.         if( ntoks < MAX_TOKENS ) {
  881.             idata->idata_tokens[ntoks].tok_kind = k;
  882.             idata->idata_tokens[ntoks].tok_exp = e;
  883.             ntoks += 1;
  884.         }
  885.     }
  886.   Out:
  887.     return ntoks;
  888. }
  889.  
  890.  
  891. static Tok
  892. GetTok(idata, index)
  893.     InterpData idata;
  894.     int index;
  895. {
  896.     return &(idata->idata_tokens[index]);
  897. }
  898.  
  899.  
  900. static bool
  901. ExpMutable(exp)
  902.     Exp exp;
  903. {
  904.     return (exp->exp_name != NIL);
  905. }
  906.  
  907.  
  908. static void
  909. Assign(idata, eto, efrom)
  910.     InterpData idata;
  911.     Exp eto;
  912.     Exp efrom;
  913. {
  914.     eto->exp_type = efrom->exp_type;
  915.     eto->exp_value = efrom->exp_value;
  916. }
  917.  
  918.  
  919. static Exp
  920. CoerceToImmutable(idata, exp, resultType)
  921.     InterpData idata;
  922.     Exp exp;
  923.     int resultType;
  924. {
  925.     Exp resultExp;
  926.  
  927.     if( resultType == TYPE_NONE )
  928.         resultType = exp->exp_type;
  929.  
  930.     if( ExpMutable(exp) || (resultType != exp->exp_type) ) {
  931.         resultExp = NewExp(idata, resultType, exp->exp_value);
  932.     } else {
  933.         resultExp = exp;
  934.     }
  935.     return resultExp;
  936. }
  937.  
  938.  
  939. static unsigned
  940. CallFuncChild(self)
  941.     XR_MesaProc self;
  942. {
  943.     CallRecord cr;
  944.     unsigned *a;
  945.     int ans;
  946.  
  947.     cr = ((CallRecord)(self->mp_x));
  948.  
  949.     XR_MonitorEntry( &(cr->cr_ml) );
  950.         /*
  951.          * It's now safe for InterpGetMyCR to read cr->cr_calleeThread
  952.          *   and it will remain safe after lock is released ...
  953.         */
  954.     XR_MonitorExit( &(cr->cr_ml) );
  955.  
  956.     cr->cr_result = NIL;
  957.     a = cr->cr_args;
  958.     if( cr->cr_nArgs <= 6 ) {
  959.         ans = (*(cr->cr_calleeCProc))(a[0], a[1], a[2], a[3], a[4], a[5]);
  960.     } else /* if( cr->cr_nArgs <= 12 ) */ {
  961.         ans = (*(cr->cr_calleeCProc))(a[0], a[1], a[2], a[3], a[4], a[5],
  962.                 a[6], a[7], a[8], a[9], a[10], a[11]);
  963.     }
  964.     XR_MonitorEntry( &(cr->cr_ml) );
  965.     if( cr->cr_idata != NIL )
  966.         cr->cr_result = NewExp( cr->cr_idata, TYPE_NONE, ((unsigned)(ans)) );
  967.     XR_Notify( &(cr->cr_cvDone) );
  968.     XR_MonitorExit( &(cr->cr_ml) );
  969.     return NIL;
  970. }
  971.  
  972.  
  973. static void
  974. InsertOnCRList(cr)
  975.     CallRecord cr;
  976. {
  977.     XR_MonitorEntry( &(callRecordsLock) );
  978.     cr->cr_next = callRecords;
  979.     callRecords = cr;
  980.     XR_MonitorExit( &(callRecordsLock) );
  981. }
  982.  
  983. static void
  984. DeleteFromCRList(cr)
  985.     CallRecord cr;
  986. {
  987.     CallRecord p, prev;
  988.  
  989.     if( cr == NIL ) return;
  990.     XR_MonitorEntry( &(callRecordsLock) );
  991.     p = callRecords; prev = NIL;
  992.     while( (p != cr) && (p != NIL) ) {
  993.         prev = p; p = p->cr_next;
  994.     }
  995.     if( p != NIL ) {
  996.         if( prev == NIL ) {
  997.             callRecords = p->cr_next;
  998.         } else {
  999.             prev->cr_next = p->cr_next;
  1000.         }
  1001.         cr->cr_next = NIL;
  1002.     }
  1003.     XR_MonitorExit( &(callRecordsLock) );
  1004. }
  1005.  
  1006.  
  1007.  
  1008. static Exp
  1009. CallFunc(idata, func, args, nArgs, doFork)
  1010.     InterpData idata;
  1011.     CProc func;
  1012.     unsigned *args;
  1013.     int nArgs;
  1014.     bool doFork;
  1015. {
  1016.     CallRecord cr;
  1017.     int ans;
  1018.     Exp result;
  1019.  
  1020.     if( func == NIL ) return ((Exp)(-1));
  1021.  
  1022.     if( nArgs > 12 ) {
  1023.         MSG1( idata,
  1024.                 "Warning: args after 12th (of %d) probably ignored\n", nArgs);
  1025.     }
  1026.  
  1027.     cr = (CallRecord)(XR_calloc(1, sizeof(struct CallRecordRep)));
  1028.     cr->cr_idata = idata;
  1029.     cr->cr_calleeCProc = func;
  1030.     cr->cr_calleeMProc.mp_proc = CallFuncChild;
  1031.     cr->cr_calleeMProc.mp_x = ((unsigned)(cr));
  1032.     cr->cr_nArgs = nArgs;
  1033.     (void)bcopy(args, &(cr->cr_args[0]), nArgs*sizeof(unsigned));
  1034.     InsertOnCRList(cr);
  1035.     if( doFork ) {
  1036.         XR_InitializeCondition( &(cr->cr_cvDone), XR_WAIT_FOREVER );
  1037.         if( idata->idata_callTimeoutMsec != 0 ) {
  1038.             XR_SetTimeout( &(cr->cr_cvDone),
  1039.                     XR_MsecToTicks(idata->idata_callTimeoutMsec) );
  1040.         }
  1041.         XR_EnableAborts( &(cr->cr_cvDone) );
  1042.         XR_MonitorEntry(&(cr->cr_ml));
  1043.         XR_Fork( &(cr->cr_calleeThread), &(cr->cr_calleeMProc) );
  1044.         (void)XR_DetachCT( &(cr->cr_calleeThread) );
  1045.         ans = XR_WaitCV( &(cr->cr_cvDone), &(cr->cr_ml) );
  1046.         result = cr->cr_result;
  1047.         cr->cr_idata = NIL;
  1048.         XR_MonitorExit( &(cr->cr_ml) );
  1049.         if( ans != 0 ) {
  1050.             /* aborted ... */
  1051.             result = ((Exp)(-1));
  1052.             (void) XR_AbortCT( &(cr->cr_calleeThread) );
  1053.         } else if( result == NIL ) {
  1054.             /* timed out ... */
  1055.         } else {
  1056.             /* okay ... */
  1057.             DeleteFromCRList(cr);
  1058.         }
  1059.     } else {
  1060.         (void)((*(cr->cr_calleeMProc.mp_proc))(cr->cr_calleeMProc));
  1061.         result = cr->cr_result;
  1062.         cr->cr_idata = NIL;
  1063.         DeleteFromCRList(cr);
  1064.     }
  1065.     return result;
  1066. }
  1067.  
  1068.  
  1069. int /* numTokensConsumed */
  1070. Interp(idata, startPos, resultPtr)
  1071.     InterpData idata;
  1072.     int startPos;
  1073.     Exp *resultPtr;
  1074. {
  1075.   int i, pos, ans;
  1076.   Exp e1, e2, eRes;
  1077.   unsigned callArgs[MAX_CALLARGS];
  1078.   Tok theTok;
  1079.  
  1080.     CLEAR_INTERP_ERR(idata);
  1081.     pos = startPos;
  1082.     theTok = GetTok(idata, pos);
  1083.     switch( theTok->tok_kind ) {
  1084.         case TOK_ASSIGN:
  1085.             pos += 1;
  1086.             if( (ans = Interp(idata, pos, &e1)) <= 0 )
  1087.                 INTERP_ERR(idata, pos, "bad assign lhs");
  1088.             pos += ans;
  1089.             if( ! ExpMutable(e1) )
  1090.                 INTERP_ERR(idata, pos, "assign lhs not var");
  1091.             if( (ans = Interp(idata, pos, &eRes)) <= 0 )
  1092.                 INTERP_ERR(idata, pos, "bad assign rhs");
  1093.             pos += ans;
  1094.             eRes = CoerceToImmutable(idata, eRes, TYPE_NONE);
  1095.             Assign(idata, e1, eRes);
  1096.             break;
  1097.         case TOK_LBRACKET2:
  1098.         case TOK_LBRACKET:
  1099.             pos += 1;
  1100.             if( (ans = Interp(idata, pos, &e1)) <= 0 )
  1101.                 INTERP_ERR(idata, pos, "missing proc in call");
  1102.             pos += ans;
  1103.             e1 = CoerceToImmutable(idata, e1, TYPE_NONE);
  1104.             (void)bzero(callArgs, (sizeof callArgs));
  1105.             i = 0;
  1106.             for(;;) {
  1107.                 if( GetTok(idata, pos)->tok_kind == TOK_RBRACKET ) {
  1108.                     pos += 1; break;
  1109.                 }
  1110.                 if( (ans = Interp(idata, pos, &e2)) <= 0 )
  1111.                     INTERP_ERR(idata, pos, "bad arg");
  1112.                 pos += ans;
  1113.                 if( i >= MAX_CALLARGS )
  1114.                     INTERP_ERR(idata, pos, "too many args in function call");
  1115.                 callArgs[i] =
  1116.                         CoerceToImmutable(idata, e2, TYPE_NONE)->exp_value;
  1117.                 i += 1;
  1118.             }
  1119.             eRes = CallFunc(idata, ((CProc)(e1->exp_value)), callArgs, i, 
  1120.                     /*doFork:*/ (theTok->tok_kind == TOK_LBRACKET) );
  1121.             if( eRes == NIL ) {
  1122.                 INTERP_ERR(idata, pos, "function call timed out");
  1123.             } else if( eRes == ((Exp)(-1)) ) {
  1124.                 INTERP_ERR(idata, pos, "function call aborted ");
  1125.             }
  1126.             break;
  1127.         case TOK_CAST:
  1128.             pos += 1;
  1129.             if( (ans = Interp(idata, pos, &e1)) <= 0 )
  1130.                 INTERP_ERR(idata, pos, "bad cast type exp");
  1131.             pos += ans;
  1132.             if( e1->exp_type == TYPE_NONE )
  1133.                 INTERP_ERR(idata, pos, "no type for cast type exp");
  1134.             if( (ans = Interp(idata, pos, &e2)) <= 0 )
  1135.                 INTERP_ERR(idata, pos, "bad cast exp");
  1136.             pos += ans;
  1137.             eRes = CoerceToImmutable(idata, e2, e1->exp_type);
  1138.             break;
  1139.         case TOK_ADD:
  1140.         case TOK_SUB:
  1141.         case TOK_MUL:
  1142.         case TOK_DIV:
  1143.             pos += 1;
  1144.             if( (ans = Interp(idata, pos, &e1)) <= 0 )
  1145.                 INTERP_ERR(idata, pos, "bad binary exp first operand");
  1146.             pos += ans;
  1147.             e1 = CoerceToImmutable(idata, e1, TYPE_WORD32);
  1148.             if( (ans = Interp(idata, pos, &e2)) <= 0 )
  1149.                 INTERP_ERR(idata, pos, "bad cast exp");
  1150.             pos += ans;
  1151.             e2 = CoerceToImmutable(idata, e2, TYPE_WORD32);
  1152.             switch( theTok->tok_kind ) {
  1153.                 case TOK_ADD: ans = e1->exp_value + e2->exp_value; break;
  1154.                 case TOK_SUB: ans = e1->exp_value - e2->exp_value; break;
  1155.                 case TOK_MUL: ans = e1->exp_value * e2->exp_value; break;
  1156.                 case TOK_DIV: ans = e1->exp_value / e2->exp_value; break;
  1157.             }
  1158.             eRes = NewExp( idata, TYPE_WORD32, ((unsigned)(ans)) );
  1159.             break;
  1160.         case TOK_DEREF:
  1161.             pos += 1;
  1162.             if( (ans = Interp(idata, pos, &e1)) <= 0 )
  1163.                 INTERP_ERR(idata, pos, "bad deref exp operand");
  1164.             pos += ans;
  1165.             e1 = CoerceToImmutable(idata, e1, TYPE_ADDRESS);
  1166.             ans = e1->exp_value;
  1167.             if( (ans < (64*1024)) || ((ans & 03) != 0) )
  1168.                 INTERP_ERR(idata, pos, "deref memory fault");
  1169.             eRes = NewExp( idata, TYPE_WORD32, *((unsigned *)(ans)) );
  1170.             break;
  1171.         case TOK_VAR:
  1172.         case TOK_CONST:
  1173.             eRes = GetTok(idata, pos)->tok_exp;
  1174.             pos += 1;
  1175.             break;
  1176.         default:
  1177.             INTERP_ERR(idata, pos, "syntax error");
  1178.     }
  1179.  
  1180.     *resultPtr = eRes;
  1181.     return (pos - startPos);
  1182. }
  1183.  
  1184.  
  1185. static void
  1186. PrintExp(idata, e)
  1187.     InterpData idata;
  1188.     Exp e;
  1189. {
  1190.     char *s;
  1191.     int i;
  1192.  
  1193.     if( e == NIL ) {
  1194.         MSG0(idata, "(nil)\n");
  1195.         return;
  1196.     }
  1197.     switch( e->exp_type ) {
  1198.         case TYPE_ERR:
  1199.             MSG0(idata, "(error)\n");
  1200.             break;
  1201.         case TYPE_CHAR:
  1202.             MSG2(idata, "'%c' (0x%x)\n",
  1203.                     e->exp_value, e->exp_value);
  1204.             break;
  1205.         case TYPE_STRING:
  1206.             s = (char *)(e->exp_value);
  1207.             MSG0(idata, "\"");
  1208.             for( i = 0; i < 250; i++ ) {
  1209.                 if( (*s) == 0 ) break;
  1210.                 MSG1(idata, "%c", *s);
  1211.                 s++;
  1212.             }
  1213.             MSG0(idata, "\"\n");
  1214.             break;
  1215.         case TYPE_ADDRESS:
  1216.             MSG1(idata, "0x%x -> ", e->exp_value);
  1217.             if( ValidAddress(e->exp_value, 1, sizeof(unsigned)) ) {
  1218.                 MSG2(idata, "%d (0x%x)\n",
  1219.                         *((unsigned *)(e->exp_value)),
  1220.                         *((unsigned *)(e->exp_value)) );
  1221.             } else {
  1222.                 MSG0(idata, "(bad address)\n");
  1223.             }
  1224.             break; 
  1225.         default:
  1226.             MSG2(idata, "%d (0x%x)\n",
  1227.                     e->exp_value, e->exp_value);
  1228.             break; 
  1229.     }
  1230. }
  1231.  
  1232.  
  1233. /*
  1234.  * Stuff that can be used by functions called from the interpreter
  1235.  */
  1236.  
  1237. static CallRecord
  1238. InterpGetMyCR()
  1239. {
  1240.     struct XR_CTRep me;
  1241.     CallRecord ans = NIL;
  1242.     CallRecord cr;
  1243.  
  1244.     XR_GetCurrent( &me );
  1245.     XR_MonitorEntry( &(callRecordsLock) );
  1246.     for( cr = callRecords; cr != NIL; cr = cr->cr_next ) {
  1247.         if( (cr->cr_calleeThread.ct_thread == me.ct_thread)
  1248.                 && (cr->cr_calleeThread.ct_gen == me.ct_gen) ) {
  1249.             ans = cr;
  1250.             break;
  1251.         }
  1252.     }
  1253.     XR_MonitorExit( &(callRecordsLock) );
  1254.     return ans;
  1255. }
  1256.  
  1257.  
  1258. int
  1259. InterpCallNArgs()
  1260. {
  1261.     CallRecord cr;
  1262.  
  1263.     cr = InterpGetMyCR();
  1264.     if( cr == NIL ) return (-1);
  1265.     return cr->cr_nArgs;
  1266. }
  1267.  
  1268.  
  1269. unsigned *
  1270. InterpCallArgs()
  1271. {
  1272.     CallRecord cr;
  1273.  
  1274.     cr = InterpGetMyCR();
  1275.     if( cr == NIL ) return NIL;
  1276.     return cr->cr_args;
  1277. }
  1278.  
  1279. void
  1280. InterpCallMsg4(fmt, x1, x2, x3, x4)
  1281.     char *fmt;
  1282.     unsigned x1, x2, x3, x4;
  1283. {
  1284.     CallRecord cr;
  1285.  
  1286.     cr = InterpGetMyCR();
  1287.     if( cr == NIL ) {
  1288.         MSG4(NIL, fmt, x1, x2, x3, x4);
  1289.     } else {
  1290.         XR_MonitorEntry( &(cr->cr_ml) );
  1291.         MSG4(cr->cr_idata, fmt, x1, x2, x3, x4);
  1292.         XR_MonitorExit( &(cr->cr_ml) );
  1293.     }
  1294. }
  1295.  
  1296.  
  1297. /*
  1298.  * Primitives -- stuff it's useful to call from the interpreter
  1299.  */
  1300.  
  1301.  
  1302. int
  1303. wpoke()
  1304. /*
  1305.     eval [ wpoke addr word1 ... wordk ]
  1306.  
  1307.     store word1 ... wordk in conscutive locations starting at addr
  1308. */
  1309. {
  1310.     CallRecord cr;
  1311.     unsigned *pFrom;
  1312.     int n;
  1313.     unsigned *pTo;
  1314.  
  1315.     if( (cr = InterpGetMyCR()) == NIL ) return (-1);
  1316.     pFrom = cr->cr_args;
  1317.     n = cr->cr_nArgs;
  1318.  
  1319.     if( pFrom == NIL ) return (-2);
  1320.     pTo = (unsigned *)(*pFrom++); n -= 1;
  1321.     if( pTo == NIL ) return (-3);
  1322.     if( !ValidAddress( ((XR_Pointer)(pTo)), n, sizeof(unsigned) ) ) {
  1323.         InterpCallMsg4("(bad address 0x%x)\n", pTo, 0, 0, 0);
  1324.         return (-4);
  1325.     }
  1326.     while( n > 0 ) { *pTo++ = *pFrom++; n -= 1; }
  1327.     return 0;
  1328. }
  1329.  
  1330.  
  1331. int
  1332. bpoke()
  1333. /*
  1334.     like wpoke but byte-by-byte
  1335. */
  1336. {
  1337.     CallRecord cr;
  1338.     unsigned *pFrom;
  1339.     int n;
  1340.     unsigned char *pTo;
  1341.     
  1342.     if( (cr = InterpGetMyCR()) == NIL ) return (-1);
  1343.     pFrom = cr->cr_args;
  1344.     n = cr->cr_nArgs;
  1345.  
  1346.     if( pFrom == NIL ) return (-2);
  1347.     pTo = (unsigned char *)(*pFrom++); n -= 1;
  1348.     if( pTo == NIL ) return (-3);
  1349.     if( !ValidAddress( ((XR_Pointer)(pTo)), n, sizeof(char) ) ) {
  1350.         InterpCallMsg4("(bad address 0x%x)\n", pTo, 0, 0, 0);
  1351.         return (-4);
  1352.     }
  1353.     while( n > 0 ) { *pTo++ = *pFrom++; n -= 1; }
  1354.     return 0;
  1355. }
  1356.  
  1357.  
  1358.  
  1359. int
  1360. wpeek()
  1361. /*
  1362.     eval [ wpeek addr nwords ]
  1363.  
  1364.     print contents of nwords memory locations starting at addr
  1365. */
  1366. {
  1367.     CallRecord cr;
  1368.     unsigned *ap;
  1369.     int acnt;
  1370.     unsigned n, x;
  1371.     unsigned *p;
  1372.  
  1373.     if( (cr = InterpGetMyCR()) == NIL ) return (-1);
  1374.     ap = cr->cr_args;
  1375.     acnt = cr->cr_nArgs;
  1376.  
  1377.     if( acnt <= 0 ) return (-2);
  1378.     if( ap == NIL ) return (-3);
  1379.     p = ((unsigned *)(*ap++));  acnt--;
  1380.     n = ((acnt > 0) ? (*ap++) : 1 );
  1381.     if( n == 0 ) return 0;
  1382.     if( !ValidAddress( ((XR_Pointer)(p)), n, sizeof(unsigned) ) ) {
  1383.         InterpCallMsg4("(bad address 0x%x)\n", p, 0, 0, 0);
  1384.         return 0;
  1385.     }
  1386.     while( n > 0 ) {
  1387.         x = *p++; n--;
  1388.         InterpCallMsg4("%d (0x%x)%s", x, x, ((n > 0) ? (", ") : ("\n")), 0);
  1389.     }
  1390.     return ((int)(x));
  1391. }
  1392.  
  1393.  
  1394. int
  1395. bpeek()
  1396. /*
  1397.     like wpeek but byte-by-byte
  1398. */
  1399. {
  1400.     CallRecord cr;
  1401.     unsigned *ap;
  1402.     int acnt;
  1403.     unsigned n, x;
  1404.     unsigned *p;
  1405.     unsigned char *pFrom;
  1406.  
  1407.     if( (cr = InterpGetMyCR()) == NIL ) return (-1);
  1408.     ap = cr->cr_args;
  1409.     acnt = cr->cr_nArgs;
  1410.  
  1411.     if( acnt <= 0 ) return (-2);
  1412.     if( ap == NIL ) return (-3);
  1413.     p = ((unsigned *)(*ap++));  acnt--;
  1414.     n = ((acnt > 0) ? (*ap++) : 1 );
  1415.     if( n == 0 ) return 0;
  1416.     if( !ValidAddress( ((XR_Pointer)(p)), n, sizeof(unsigned char) ) ) {
  1417.         InterpCallMsg4("(bad address 0x%x)\n", p, 0, 0, 0);
  1418.         return 0;
  1419.     }
  1420.     pFrom = ((unsigned char *)(p));
  1421.     while( n > 0 ) {
  1422.         x = *pFrom++; n--;
  1423.         InterpCallMsg4("%d (0x%x)%s", x, x, ((n > 0) ? (", ") : ("\n")), 0);
  1424.     }
  1425.     return ((int)(x));
  1426. }
  1427.  
  1428.  
  1429. int
  1430. wnew()
  1431. /*
  1432.     eval [ wnew word1 ... wordk ]
  1433.  
  1434.     allocate a collectable object filled with words word1 ... wordk
  1435. */
  1436. {
  1437.     CallRecord cr;
  1438.     unsigned *ap;
  1439.     int len;
  1440.     unsigned *p;
  1441.     
  1442.     if( (cr = InterpGetMyCR()) == NIL ) return (-1);
  1443.     ap = cr->cr_args;
  1444.     len = cr->cr_nArgs * sizeof(unsigned);
  1445.  
  1446.     if( len <= 0 ) return (-2);
  1447.     if( ap == NIL ) return (-3);
  1448.     p = (unsigned *)(XR_malloc( len ));
  1449.     (void)bcopy( ((char *)(ap)), ((char *)(p)), len );
  1450.     return ((int)(p));
  1451. }
  1452.  
  1453.  
  1454.  
  1455. /*
  1456.  * The body of the interpreter ...
  1457.  */
  1458.  
  1459. static int
  1460. DoInterpUnderLock(idata, cmd)
  1461.     InterpData idata;
  1462.     char *cmd;
  1463. {
  1464.     Exp e, e2;
  1465.     int pos, ans;
  1466.     bool gotValue = FALSE;
  1467.  
  1468.     while( (*cmd != 0) && (*cmd != ' ') ) cmd++;
  1469.     ans = ScanArgs(idata, cmd);
  1470.     if( ans < 0 ) {
  1471.         MSG2(idata, "ERROR: %s (at token %d)\n",
  1472.                 idata->idata_errMsg, idata->idata_errPos );
  1473.         return 0;
  1474.     } 
  1475.     pos = 0;
  1476.     while( GetTok(idata, pos)->tok_kind != TOK_EOF ) {
  1477.         if( GetTok(idata, pos)->tok_kind == TOK_SEPARATOR ) {
  1478.             ans = 1;
  1479.         } else {
  1480.             ans = Interp(idata, pos, &e);
  1481.             gotValue = TRUE;
  1482.         }
  1483.         if( ans <= 0 ) {
  1484.             MSG2(idata, "ERROR: %s (at token %d)\n",
  1485.                     idata->idata_errMsg, idata->idata_errPos );
  1486.             return 0;
  1487.         }
  1488.         pos += ans;
  1489.     }
  1490.     if( gotValue ) {
  1491.         idata->idata_varIndex += 1;
  1492.         e2 = ScanVar(idata, "&");
  1493.         Assign(idata, e2, e);
  1494.         MSG1(idata, "&%d: ", idata->idata_varIndex );
  1495.         PrintExp(idata, e);
  1496.     } else {
  1497.         MSG0(idata, "\n");
  1498.     }
  1499.     return 0;
  1500. }
  1501.  
  1502.  
  1503. static unsigned
  1504. DesperationPutProc(s, d)
  1505.     char *s;
  1506.     XR_Pointer d;
  1507. {
  1508.     XR_ConsoleMsg("%s", s);
  1509.     return 0;
  1510. }
  1511.  
  1512.  
  1513. /*
  1514.  * exported for use by Mesa, etc ...
  1515.  */
  1516.  
  1517. int
  1518. XR_Interp(idata, putProc, putClientData, callTimeoutMsec, cmd)
  1519.     InterpData idata;
  1520.     CProc putProc /*(char *s, XR_Pointer clientData)*/;
  1521.     XR_Pointer putClientData;
  1522.     unsigned callTimeoutMsec;
  1523.     char *cmd;
  1524. {
  1525.     int ans;
  1526.     CProc savPutProc;
  1527.     XR_Pointer savPutClientData;
  1528.     unsigned savCallTimeoutMSec;
  1529.  
  1530.     if( idata == NIL ) idata = interpData;
  1531.     XR_MonitorEntry( &(idata->idata_ml) );
  1532.     savPutProc = idata->idata_putProc;
  1533.     savPutClientData = idata->idata_putClientData;
  1534.     savCallTimeoutMSec = idata->idata_callTimeoutMsec;
  1535.     if( putClientData != NIL ) {
  1536.         if( putProc == NIL ) putProc = *((CProc *)(putClientData));
  1537.     }
  1538.     if( putProc != NIL ) {
  1539.         idata->idata_putProc = putProc;
  1540.         idata->idata_putClientData = putClientData;
  1541.     } else if( savPutProc == NIL ) {
  1542.         idata->idata_putProc = DesperationPutProc;
  1543.         idata->idata_putClientData = NIL;
  1544.     }
  1545.     idata->idata_callTimeoutMsec = callTimeoutMsec;
  1546.     ans = DoInterpUnderLock(idata, cmd);
  1547.     idata->idata_putProc = savPutProc;
  1548.     idata->idata_putClientData = savPutClientData;
  1549.     idata->idata_callTimeoutMsec = savCallTimeoutMSec;
  1550.     XR_MonitorExit( &(idata->idata_ml) );
  1551.     return ans;
  1552. }
  1553.  
  1554.  
  1555. InterpData
  1556. XR_MakeInterpHandle()
  1557. {
  1558.     InterpData idata = 
  1559.             ((InterpData)(XR_calloc( 1, sizeof(struct InterpDataRep))));
  1560.     return idata;
  1561. }
  1562.  
  1563. void
  1564. XR_SetInterpPutProc(idata, proc, data)
  1565.     InterpData idata;
  1566.     CProc proc;
  1567.     XR_Pointer data;
  1568. {
  1569.     if( idata == NIL ) idata = interpData;
  1570.     XR_MonitorEntry( &(idata->idata_ml) );
  1571.     idata->idata_putProc = proc;
  1572.     idata->idata_putClientData = data;
  1573.     XR_MonitorExit( &(idata->idata_ml) );
  1574. }
  1575.  
  1576.  
  1577. /*
  1578.  * Stuff for registration with PCR command loop
  1579.  */
  1580.  
  1581.  
  1582.  
  1583. static int
  1584. InterpPutProc(s, clce)
  1585.     char *s;
  1586.     XR_CLCallEnv clce;
  1587. {
  1588.     if( s != NIL )
  1589.         (*(clce->clce_msgSink->mp_proc))(s, strlen(s), clce->clce_msgSink);
  1590.     return 0;
  1591. }
  1592.  
  1593.  
  1594. static char *
  1595. ReconstructCmdLine(argc, argv)
  1596.     int argc;
  1597.     char **argv;
  1598. {
  1599.     int i, len, totalLen;
  1600.     char *result;
  1601.  
  1602.     totalLen = 1; /* for trailing null if argc == 0 */
  1603.     for( i = 0; i < argc; i++ ) totalLen += (1+strlen(argv[i]));
  1604.     result = (char *)XR_malloc(totalLen);
  1605.     totalLen = 0;
  1606.     i = 0;
  1607.     for(;;) {
  1608.         len = strlen(argv[i]);
  1609.         (void)bcopy(argv[i], &(result[totalLen]), len);
  1610.         totalLen += len;
  1611.         if( (++i) >= argc ) break;
  1612.         result[totalLen] = ' ';
  1613.         totalLen += 1;
  1614.     }
  1615.     result[totalLen] = 0;
  1616.     return result;
  1617. }
  1618.  
  1619.  
  1620. static /* XR_CLProc */ int
  1621. InterpCLProc(clce, argc, argv, prevResult, self)
  1622.     XR_CLCallEnv clce;
  1623.     int argc;
  1624.     char **argv;
  1625.     int prevResult;
  1626.     XR_MesaProc self;
  1627. {
  1628.     (void) XR_Interp(
  1629.         /* interpdata */ self->mp_x,
  1630.         InterpPutProc, clce,
  1631.         defaultCallTimeoutMsec,
  1632.         ReconstructCmdLine(argc, argv)
  1633.     ); 
  1634.     return 1;
  1635. }
  1636.  
  1637.  
  1638.  
  1639. int
  1640. XR_run_Interp() {
  1641.     interpData = XR_MakeInterpHandle();
  1642.     interpDataForConstEval = XR_MakeInterpHandle();
  1643.     (void)XR_CLRegisterProc(
  1644.         XR_globalCLProcsHandle,
  1645.         "eval", FALSE, "evaluate a simple expression",
  1646.         XR_MakeMesaProc(InterpCLProc, interpData),
  1647.         TRUE
  1648.     );
  1649. }
  1650.  
  1651.  
  1652. /*
  1653.  * Program debugging interface from C -- print console messages, save values to
  1654.  *   be examined with interpreter.
  1655.  */
  1656.  
  1657. static int XR_doSaveForInterp = 2;
  1658.     /* 0 => disabled, 1 => save but don't print, 2 => save and print */
  1659.  
  1660. int XR_SetSaveForInterp(x) int x; { XR_doSaveForInterp = x; return x; }
  1661.  
  1662. int XR_GetSaveForInterp() { return XR_doSaveForInterp; }
  1663.  
  1664.  
  1665. int
  1666. XR_SaveForCInterp(p, m)
  1667.     XR_Pointer p; /* value to be saved */
  1668.     char *m; /* optional message to print */
  1669. {
  1670.     InterpData idata = interpDataForConstEval;
  1671.     int varIndex = 0;
  1672.     Exp lhs, rhs;
  1673.  
  1674.     XR_MonitorEntry( &(idata->idata_ml) );
  1675.     if( (p != NIL) && (XR_doSaveForInterp > 0) ) {
  1676.         varIndex = (idata->idata_varIndex += 1);
  1677.         lhs = ScanVar(idata, "&");
  1678.         rhs = NewExp(idata, TYPE_NONE, p);
  1679.         Assign(idata, lhs, rhs);
  1680.     }
  1681.     if( (m != NIL) && (XR_doSaveForInterp > 1) ) {
  1682.         MSG1( idata, "0x%x ", p);
  1683.         if( varIndex != 0 )
  1684.            MSG1( idata, "(saved as &%d) ", varIndex );
  1685.         MSG1( idata, "%s\n", m );
  1686.     }
  1687.     XR_MonitorExit( &(idata->idata_ml) );
  1688.     return varIndex;
  1689. }
  1690.  
  1691. /*
  1692.  * Interface from Cedar ...
  1693.  */
  1694.  
  1695. /* rope<->string */
  1696.  
  1697. static char * (*uxStringsDotCreate)() = NIL;
  1698.  
  1699. char *
  1700. XR_CharStarFromRope(r, r2)
  1701.     XR_Pointer r, r2; /* r2 for backward compatibility, should go away */
  1702. {
  1703.     if( r == NIL ) r = r2;
  1704.     if( !ValidAddress(r, 1, 4) ) r = NIL;
  1705.     if( uxStringsDotCreate == NIL ) {
  1706.         Exp e;
  1707.         XR_MonitorEntry( &(interpDataForConstEval->idata_ml) );
  1708.         e = ScanConst(interpDataForConstEval, "UXStringsImpl.Create");
  1709.         if( e != NIL )
  1710.             *((unsigned *)(&uxStringsDotCreate)) = e->exp_value;
  1711.         XR_MonitorExit( &(interpDataForConstEval->idata_ml) );
  1712.         if( uxStringsDotCreate == NIL ) return NIL;
  1713.     }
  1714.     return (*uxStringsDotCreate)(r, NIL);
  1715. }
  1716.  
  1717. static XR_Pointer (*uxStringsDotToRope)(/*r, len*/) = NIL;
  1718.  
  1719. XR_Pointer
  1720. XR_RopeFromCharStar(s, s2)
  1721.     char *s, *s2;
  1722. {
  1723.     if( s == NIL ) s = s2;
  1724.     if( s == NIL ) s = "(nil)";
  1725.     else if( !ValidAddress(s, 1, 1) ) s = "(bad address)";
  1726.     if( uxStringsDotToRope == NIL ) {
  1727.         Exp e;
  1728.         XR_MonitorEntry( &(interpDataForConstEval->idata_ml) );
  1729.         e = ScanConst(interpDataForConstEval, "UXStringsImpl.ToRope");
  1730.         if( e != NIL )
  1731.             *((unsigned *)(&uxStringsDotToRope)) = e->exp_value;
  1732.         XR_MonitorExit( &(interpDataForConstEval->idata_ml) );
  1733.         if( uxStringsDotToRope == NIL ) return NIL;
  1734.     }
  1735.     return (*uxStringsDotToRope)(s, strlen(s)+16 );
  1736. }
  1737.  
  1738.  
  1739. /* console messages */
  1740.  
  1741. void
  1742. XR_ConsoleMsgRope(r)
  1743.     XR_Pointer r;
  1744. {
  1745.     XR_ConsoleMsg("%s", XR_CharStarFromRope(r));
  1746. }
  1747.  
  1748.  
  1749. int
  1750. XR_SaveForMesaInterp(p, m)
  1751.     XR_Pointer p; /* value to be saved */
  1752.     XR_Pointer m; /* optional message to print */
  1753. {
  1754.     return XR_SaveForCInterp(p, XR_CharStarFromRope(NIL, m) );
  1755. }
  1756.  
  1757.  
  1758. /* the following is for historic reasons ... */
  1759. int
  1760. XR_SaveForInterp(p, m)
  1761.     XR_Pointer p; /* value to be saved */
  1762.     XR_Pointer m; /* optional message to print */
  1763. {
  1764.     return XR_SaveForMesaInterp(p, m);
  1765. }
  1766.  
  1767.